Delphi Magazine Collection 2001/Delphi Magazine Collection 20001 (2001).iso/DISKS/Issue46/packages/DinoSource.Zip/WindowMenu.pas

Pascal/Delphi Source File | 1998-10-29 | 7.7 KB | 267 lines

unit WindowMenu;

{$ifdef Ver100} { Delphi 3.0x }
  {$define DelphiLessThan4}
{$endif}
{$ifdef Ver110} { C++ Builder 3.0x }
  {$define DelphiLessThan4}
{$endif}

interface

procedure Register;

implementation

uses
  ExptIntf, ToolIntf, Windows, Messages, CommonStuff, Menus, Forms, SysUtils,
  Dialogs, ExtCtrls;

type
  TWindowMenu = class(TIExpert)
  private
    FWindowMenu: TIMenuItemIntf;
    FWindowMenuOption: TMenuItem;
  protected
    procedure DoAbout(Sender: TIMenuItemIntf);
    procedure DoWindowMenu(Sender: TObject);
    procedure DoWindowMenuClick(Sender: TIMenuItemIntf);
    procedure DoWindowItemClick(Sender: TIMenuItemIntf);
    procedure SetWindowMenu(Value: Boolean);
  public
    constructor Create;
    destructor Destroy; override;
    function GetName:        string; override;
    function GetComment:     string; override;
    function GetAuthor:      string; override;
    function GetPage:        string; override;
    function GetGlyph:       HICON;  override;
    function GetStyle: TExpertStyle; override;
    function GetState: TExpertState; override;
    function GetIDString:    string; override;
    function GetMenuText:    string; override;
    procedure Execute;               override;
  end;

resourcestring
  SWindow = 'W&indow';             //Default Window menu caption
  SInspector = 'Object Inspector'; //Object Inspector window caption
  SWindowMenu = '&Window menu';    //Window menu toggle option

const
  SFormat = '&%d %s';      //Format for Window menu item
  SIconCaptionClass = '#32772'; //Class name of an NT 3.5 icon caption
  //Registry strings
  SRegWindowMenu = 'Window Menu';
  SRegWindowMenuName = 'Window Menu Caption';

constructor TWindowMenu.Create;
begin
  inherited;
  //Make sure there is an options menu - bear in mind
  //that the other options code might not be being used
  Stuff.AddOptionsItem;
  //Set up Window menu options menu item
  FWindowMenuOption := NewItem(SWindowMenu, 0,
    Stuff.Ini.ReadBool(SRegSection, SRegWindowMenu, False),
    True, DoWindowMenu, 0, '');
  //Insert the menu item
  Stuff.FOptions.Add(FWindowMenuOption);
  //Set the window menu as appropriate
  SetWindowMenu(FWindowMenuOption.Checked);
end;

destructor TWindowMenu.Destroy;
begin
  //Save Window menu existence state
  Stuff.Ini.WriteBool(SRegSection,
    SRegWindowMenu, FWindowMenuOption.Checked);
  //Delete Window menu
  SetWindowMenu(False);
  inherited Destroy
end;

procedure TWindowMenu.DoAbout(Sender: TIMenuItemIntf);
begin
  Stuff.DoAbout(nil)
end;

procedure TWindowMenu.DoWindowMenu(Sender: TObject);
begin
  //When user toggles Window menu option, set
  //checkmark and set Window menu accordingly
  with Sender as TMenuItem do
  begin
    Checked := not Checked;
    SetWindowMenu(Checked)
  end
end;

procedure TWindowMenu.DoWindowMenuClick(Sender: TIMenuItemIntf);
var
  Loop, Count, OldCount: Integer;
  PID: {$ifdef DelphiLessThan4}Integer{$else}Cardinal{$endif};
  Item: TIMenuItemIntf;
  Wnd: HWnd;
  WndClass, WndCaption: array[0..255] of Char;
begin
  //Delphi repetitively calls the OnClick events of the
  //main menu items to allow IDE code to en/disable
  //speedbuttons as necessary. We will only execute
  //this code if it is a real menu click (Sender =
  //the menu item) - not a fake one from Delphi (where
  //Sender = the main window)
  if Sender = FWindowMenu then
  begin
    Count := 0;
    //It would normally be sensible to delete the old items
    //and then add new items. But for some reason that goes
    //screwy UI-wise, so instead we add the new ones and
    //then delete the old ones
    //So, how many Window menu items were there?
    OldCount := FWindowMenu.GetItemCount;
    //Add new menu items for current windows
    Wnd := GetWindow(Application.Handle, gw_HWndFirst);
    while Wnd <> 0 do
    begin
      GetClassName(Wnd, WndClass, 255);
      GetWindowThreadProcessID(Wnd, @PID);
      //We only want windows in the Window menu
      //that are... visible, enabled, have a caption,
      //are not icon captions, are part of the Delphi
      //process and are not the Application window
      if IsWindowVisible(Wnd) and
         IsWindowEnabled(Wnd) and
         (GetWindowText(Wnd, WndCaption, 255) > 0) and
         (PID = GetCurrentProcessID) and
         (StrPas(WndClass) <> SIconCaptionClass) and
         (StrPas(WndClass) <> Application.ClassName) then
      begin
        Inc(Count);
        //Make a new menu item, remembering to put the
        //checkmark on the currently selected page
        //Menu item stores reference to the relevant form in Hint
        Item := FWindowMenu.InsertItem(FWindowMenu.GetItemCount,
          Format(SFormat, [Count, StrPas(WndCaption)]), '',
          IntToStr(Wnd), 0, 0, 57, [mfEnabled, mfVisible, mfRadioItem],
          DoWindowItemClick);
        //Put F11 next to Object Inspector item as a reminder
        if StrPas(WndCaption) = SInspector then
          Item.SetShortCut(vk_F11); //Don't use TextToShortCut!!
      end;
      Wnd := GetWindow(Wnd, gw_HWndNext)
    end;
    //Add About menu item
    FWindowMenu.InsertItem(FWindowMenu.GetItemCount, '-', '', '',
      0, 0, 0, [mfEnabled, mfVisible], nil);
    FWindowMenu.InsertItem(FWindowMenu.GetItemCount, SAbout, '',
      '', 0, 0, 0, [mfEnabled, mfVisible], DoAbout);
    //Now delete the old (potentially wrong) window menu items
    for Loop := 1 to OldCount do
      FWindowMenu.GetItem(0).DestroyMenuItem;
  end
end;

procedure TWindowMenu.DoWindowItemClick(Sender: TIMenuItemIntf);
begin
  //Restore selected window (in case it was minimised)
  PostMessage(StrToInt(Sender.GetHint), wm_SysCommand, sc_Restore, 0);
  //Make selected window active
  SetForegroundWindow(StrToInt(Sender.GetHint))
end;

procedure TWindowMenu.SetWindowMenu(Value: Boolean);
var
  FMainmenu: TIMainMenuIntf;
begin
  if Value then
  begin
    if Assigned(ToolServices) then
    begin
      FMainMenu := ToolServices.GetMainMenu;
      if Assigned(FMainMenu) then
        try
          FWindowMenu := FMainMenu.GetMenuItems.InsertItem(
            FMainMenu.GetMenuItems.GetItemCount-1,
            Stuff.Ini.ReadString(SRegSection, SRegWindowMenuName, SWindow),
            '', '', 0, 0, 0, [mfEnabled, mfVisible], DoWindowMenuClick)
        finally
          FMainMenu.Free
        end
    end
  end
  else
  begin
    //This deletes the Window menu
    if Assigned(FWindowMenu) then
    begin
      FWindowMenu.DestroyMenuItem;
      FWindowMenu := nil
    end
  end;
{$ifndef DelphiLessThan4}
  //Resize menu bar to take account of added/deleted menu item
  if Assigned(Stuff.FControlBar) then
  begin
    Stuff.FControlBar.Perform(wm_LButtonDown, 0, MakeLong(0, 0));
    Stuff.FControlBar.Perform(wm_LButtonUp, 0, MakeLong(0, 0));
  end
{$endif}
end;

function TWindowMenu.GetName: string;
begin
  Result := 'Archaeopteryx''s Window Menu';
end;

function TWindowMenu.GetComment: string;
begin
  Result := '';
end ;

function TWindowMenu.GetAuthor: string;
begin
  Result := '';
end ;

function TWindowMenu.GetPage: string;
begin
  Result := '';
end;

function TWindowMenu.GetGlyph: HICON;
begin
  Result := 0;
end;

function TWindowMenu.GetStyle: TExpertStyle;
begin
  Result := esAddIn;
end;

function TWindowMenu.GetState: TExpertState;
begin
  Result := [esEnabled];
end;

function TWindowMenu.GetIDString: string;
begin
  Result := 'Archaeopteryx.WindowMenu';
end;

function TWindowMenu.GetMenuText: string;
begin
  Result := '';
end ;

procedure TWindowMenu.Execute;
begin
end;

procedure Register;
begin
  RegisterLibraryExpert(TWindowMenu.Create)
end;

end.